home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
OVERLAY
/
SWAPLOG
/
SWAPLOG.PAS
Wrap
Pascal/Delphi Source File
|
1993-12-22
|
29KB
|
800 lines
unit swaplog;
{ original unit SWAPLOG, written by Tom Field - 76247,3024 as of 30 Aug 91 }
{ current unit SWAPLOG, written by Mark Reichert - 72763,2417 as of 13 Dec 93 }
{ This unit intercepts overlay load operations and prints a log of each
overlay load. It is useful in studying the overlay loading in a
program when trying to eliminate thrashing.
The unit must find a _current_ .MAP file (produced by TPC /GS) in the
executable directory. If during swapping, a segment is requested that
was not in the map file, the segment address is returned, preceded by
a question mark.
The unit is not as self initializing as the one written by Tom Field.
You should put it in your mainline's uses list after the "overlay"
unit is used. Actually, the saving of the BP OverReadFunc and its
replacement with the one here must be done after the OvrInit and if
necessary, the OvrInitEMS, wherever they are called. This is
necessary because the filling of the OverReadFunc address location
with the address of the native function is done in OvrInit and
redone in OvrInitEMS. Now, the call of the InitSwap function MUST
be done after any OvrSetBuf because OvrSetBuf needs the heap to be
EMPTY when it tries to setup the conventional memory overlay buffer.
The following is how the setup was done when the unit was tested in
the TVDEMO program in \BP\EXAMPLES\DOS\TVDEMO. An overlayed version
of this program was tested first, rather than the program written to
demo the use of overlays and resources, TVRDEMO, because I didn't
want the complication of resources. By the way, use of this unit has
convinced me that, for event-driven programs at least, EMS memory or
not, the overlay buffer needs to be large enough to hold the three or
four largest and/or frequently called units or the enormous amount of
thrashing will really slow down the program
(* This procedure allows the switch to be done and redone more easily *)
Procedure SaveAReadBuf;
Begin
If SwapLog.GoodInitSwap Then
begin
SwapLog.SaveOvrRead := OverLay.OvrReadBuf;
OVERLAY.OvrReadBuf := SwapLog.SwapOverRead;
end;
End;
(* If an EMPTY string is fed to this procedure, and is returned still
empty, then OvrResult needs to be reexamined *)
Procedure SetErrorStr(Var ErrorStr : String);
Begin
Case OvrResult Of
ovrError : ErrorStr := 'General Overlay Manager error.';
ovrNotFound : ErrorStr := 'No OVR file not found in EXE dir.';
ovrNoMemory : ErrorStr := 'Not enough memory for overlay buffer.';
ovrIOError : ErrorStr := 'General Overlay file I/O Error.';
ovrNoEMSDriver : ErrorStr := 'No EMS Driver (EMM386, QEMM, etc) installed.';
ovrNoEMSMemory : ErrorStr := 'Insufficient EMS memory available';
End;
End;
var
(* original program variables *)
Demo: TTVDemo;
EXEName: PathStr;
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
UsingEMS : Boolean;
TempStr : String;
begin
(* try to find the correct path and name for the overlay file *)
if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
else EXEName := FSearch('TVDEMOC.EXE', GetEnv('PATH'));
FSplit(EXEName, Dir, Name, Ext);
if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
EXENAME := FSearch('TVDEMOC.OVR', Dir);
(* try to initialize the overlay manager and units *)
OvrInit(EXEName);
if OvrResult <> ovrOk then
begin
TempStr := '';
SetErrorStr(TempStr);
If TempStr <> '' Then
PrintStr(TempStr+#13#10);
Halt(1);
end
Else
Begin
(* Since OvrSetBuf only affects the conventional memory overlay
buffer, it can be done before OverInitEMS *)
OvrSetBuf(48 * 1024);
(* open the overlay log file *)
OpenOverLogFile('OVERLOG.FIL');
(* Set when you want the procedure FlushLog to act -
NoFlush - has no effect, write to file done when buffer fills
FlushToDos - flushes OverLog file variable buffer to DOS buffers
FlushToDisk - flushes OverLog file variable buffer to disk file *)
SetTypeOfFlush(FlushToDisk);
(* Set up the Collection Object, here with 40 items to start and
a 10 item increase whenever the limit is reached *)
GoodInitSwap := InitSwap(40, 10);
SwapLogWrite('Did OvrInit and OvrSetBuf');
Str(OvrGetBuf:0, TempStr);
SwapLogWrite('BuffSize = ' + TempStr );
(* Save the BP OverReadFunc and substitute our own *)
SaveAReadBuf;
End;
UsingEMS := False;
SwapLogWrite('Doing OvrInitEMS');
(* try to overlay units to EMS memory and redirect manager there
when units need to be swapped into and out of the overlay buffer *)
OvrInitEMS;
If OvrResult = OvrOk Then
UsingEMS := True
Else
Begin
(* if there is an error, just report it. Conventional overlay
management will still go on, so don't Halt the program *)
TempStr := '';
SetErrorStr(TempStr);
If TempStr <> '' Then
SwapLogWrite(TempStr);
End;
If UsingEMS Then
Begin
SaveAReadBuf;
SwapLogWrite('Using Expanded')
End
Else
SwapLogWrite('Using Conventional');
Demo.Init;
Demo.Run;
Demo.Done;
(* Write out the overlayed segments sorted by LoadCount *)
WriteSortedSegmentsToLog(OvrSegLoadCount);
}
interface
Uses
Dos,
Overlay;
Type
{ For TSegmentItem Record }
string8 = string[8];
{ Flags for controlling how the text log file will be written }
FlushType = (NoFlush, FlushToDos, FlushToDisk);
{ Flags for controlling what sort is done in WriteSortedSegmentsToLog }
SortType = (OvrSegNo, OvrSegName, OvrSegLoadCount);
{ Record that will be the item controlled by TSegmentCollection Object }
{ made global in hopes that will aid typecasts for debugging purposes }
PSegmentItem = ^TSegmentItem;
TSegmentItem = record
SegNo : Word;
SegName : String8;
LoadCount : LongInt;
end;
Var
{ store the BP OvrReadFunc here }
SaveOvrRead : OVERLAY.OvrReadFunc;
{ tells the calling program that a successful it occured }
GoodInitSwap : Boolean;
{ Function to be called after a OvrSetBuf is done because OvrSetBuf needs the
heap to be empty before it runs }
Function InitSwap(ALimit, ADelta: Integer) : boolean;
{ function to replace BP's OvrReadFunc }
Function SwapOverRead( OvrSeg : Word): integer; far;
{ Procedure to allow user to write messages to the log file }
Procedure SwapLogWrite(InStr : String);
{ Procedure to allow user to set when the log disk file is actually written to }
Procedure SetTypeOfFlush(InFlushType : FlushType);
{ Seperating Log File Opening out of InitSwap allows a SwapLogWrite before OvrSetBuf }
Procedure OpenOverLogFile(InName : PathStr);
{ Procedure to allow Writing Sorted List of Segments and Counts at any point of
program; Order is reset to SegNo at end of this procedure so that later lookups
will work. }
Procedure WriteSortedSegmentsToLog(SortChoice : SortType);
implementation
uses
Objects, { To inherit from TSortedCollection Object }
IOChek; { has functions with internal I/O Checking, also in Library }
{ This unit is in Dos Programming in the BP CompuServe Library }
type
string4 = string[4];
string19 = String[19];
TSortFunc = function(P1, P2: PSegmentItem): Integer;
PSegmentCollection = ^TSegmentCollection;
TSegmentCollection = object(TSortedCollection)
Procedure SetLimit(ALimit: Integer); virtual;
Function Compare(Key1, Key2: Pointer): Integer; virtual;
Procedure FreeItem(Item : Pointer); virtual;
Procedure ReOrder;
end;
Function SortBySegNo(P1, P2: PSegmentItem): Integer; far; assembler;
asm
les di, P1 { load first pointer }
mov ax, es:[di] { Put word value at ES:DI (SegNo) into AX }
les di, P2 { load second pointer }
sub ax, es:[di] { compare SegNo values }
jz @end { 0 is the return value for P1^.SegNo = P2^.SegNo }
rcr al, 1 { rotate CF=>sign bit for AL, CF=1 =>Neg AL, CF=0 =>Pos AL }
or al, 1 { make sure that AL <> 0 }
cbw { Convert Byte to Word => make signed AX = signed AL }
@end:
End;
{ Most of the code here was borrowed from the StrCollection Compare
in the Objects unit }
Function SortBySegName(P1, P2: PSegmentItem): Integer; far; assembler;
asm
PUSH DS
CLD { string operations in forward mode }
LDS SI,P1
ADD SI,OFFSET TSEGMENTITEM.SEGNAME { point DS:SI to P1^.SegName }
LES DI,P2
ADD DI,OFFSET TSEGMENTITEM.SEGNAME { point ES:DI to P2^.SegName }
LODSB { put P1^.SegName length byte in AL and inc SI past it }
MOV AH,ES:[DI]
INC DI { put P2^.SegName length byte in AH and inc DI past it }
MOV CL,AL { this and the next 3 lines do the following }
CMP CL,AH
JBE @@1 { CL = Min(Length(P1^.SegName), Length(P2^.SegName) }
MOV CL,AH
@@1: XOR CH,CH { make CX = CL }
REP CMPSB { compare until unequal chars found or end of shorter }
JE @@2 { if one is substring of other, compare lengths }
MOV AL,DS:[SI-1] { otherwise REP inc'd past unequal chars so put }
MOV AH,ES:[DI-1] { them in AL and AH, so that subtraction will make }
@@2: SUB AL,AH { AX < 0 if P1^.SegName < P2^.SegName }
SBB AH,AH { and AX > 0 if P1^.SegName > P2^.SegName }
POP DS
end;
Function SortByLoadCount(P1, P2: PSegmentItem): Integer; far; assembler;
asm
push ds
lds si, P1 { load first pointer }
add si, offset TSEGMENTITEM.LOADCOUNT { point DS:SI to P1^.LOADCOUNT }
les di, P2 { load second pointer }
add di, offset TSEGMENTITEM.LOADCOUNT { point ES:DI to P2^.LOADCOUNT }
mov ax, [si+2] { Put high word value at DS:SI into AX }
sub ax, es:[di+2] { compare high word values of P1^ and P2^ LoadCount }
jnz @end { If high words not equal, AX properly <0 or >0 }
{ 0 < Hi word < MaxInt, so no RCR needed as it is below }
mov ax, [si] { Put low word value at DS:SI into AX }
sub ax, es:[di] { compare low word values of P1^ and P2^ LoadCount }
jz @end { 0 is the return value for P1^.LoadCount = P2^.LoadCount }
rcr al, 1 { rotate CF=>sign bit for AL, CF=1 =>Neg AL, CF=0 =>Pos AL }
or al, 1 { make sure that AL <> 0 }
cbw { Convert Byte to Word => make signed AX = signed AL }
@end:
pop ds
End;
var
{ When the object is relatively small and will stay within the unit, no need
to add another layer of redirection by using the Pointer to the object }
SegmentDB: TSegmentCollection;
{ holds the sort requested by the WriteSortedSegmentsToLog Procedure }
SortUsed : SortType;
const Sorts : array[SortType] of TSortFunc =
(SortBySegNo, SortBySegName, SortByLoadCount);
SortsStr : array[SortType] of String19 =
('Segment Number', 'Segment Name', 'Segment Load Count');
procedure TSegmentCollection.SetLimit(ALimit: Integer);
begin
inherited SetLimit(ALimit);
{ NIL all pointers after the active ones - with a zero-indexed array,
the COUNTth item is the one after the last active element }
{ good for debugging and using Assigned to avoid using invalid pointers }
{ If Starting and Count = 0, then the whole array is initialized }
If Limit > Count Then
FillChar(Items^[Count], (Limit - Count) * SizeOf(Pointer), 0);
end;
{ Build of Collection and Lookups are done by Segment Number }
function TSegmentCollection.Compare(Key1, Key2: Pointer): Integer;
begin
Compare := SortBySegNo(Key1, Key2);
end;
{ Due to the FillChar in Descendant SetLimit, the Assigned should prevent
the Disposing of any Invalid pointers }
procedure TSegmentCollection.FreeItem(Item : Pointer);
begin
If Assigned(Item) Then
Dispose(PSegmentItem(Item));
end;
{ In the example program off of which I patterned this sort, Compare was used
directly, but that overburdened it so that the Lookups would have taken much
longer, maybe slowing the program down }
Function SortCompare(Key1, Key2: Pointer): Integer;
var Result : Integer;
SortIndx : SortType;
Begin
{ at the top of the array Key2 would be nil }
if Key2 = nil then
begin
SortCompare := 0;
Exit;
end;
{ Do the Selected Sort }
Result := Sorts[SortUsed](Key1, Key2);
{ if the sort is by LoadCount then it should be descending to
ease the sighting of the most frequently used units,
so reverse the Result variable to make a descending sort }
if SortUsed = OvrSegLoadCount Then
If Result <> 0 then
Result := Result * -1
Else
{ units CANNOT have the same name or segment mapping number so the
Result will NOT be 0; LoadCounts can be the same so get
alphabetical name order in that case }
Result := Sorts[OvrSegName](Key1, Key2);
SortCompare := Result;
End;
procedure TSegmentCollection.ReOrder;
{ This does a Quicksort, which divides the items into those lesser and
greater to "x", and then uses recursion to do the same with to each
subsequently smaller divided area until reaching indivisible single items}
procedure Sort(l, r: Integer);
var
i, j: Integer;
x, p: Pointer;
begin
repeat
i := l; j := r;
x := KeyOf(Items^[(l + r) div 2]);
repeat
while SortCompare(KeyOf(Items^[i]), x) < 0 do Inc(i);
while SortCompare(x, KeyOf(Items^[j])) < 0 do Dec(j);
if i <= j then
begin
if i < j then
begin
p := Items^[i];
Items^[i] := Items^[j];
Items^[j] := p;
end;
Inc(i); Dec(j);
end;
until i > j;
if l < j then Sort(l, j);
l := i;
until l >= r;
end;
begin
if Count > 1 then Sort(0, Count - 1);
end;
Procedure WriteSortedSegmentsToLog(SortChoice : SortType);
Var I : Integer;
P : PSegmentItem;
LCStr : String8;
Begin
{ ReOrder uses this Unit Variable SortUsed }
SortUsed := SortChoice;
{ The normal order is by SegNo }
If SortUsed <> OvrSegNo Then
SegmentDB.Reorder;
SwapLogWrite('');
SwapLogWrite('Overlay Segments And LoadCounts Sorted With Primary Key = ' +
SortsStr[SortUsed]);
{ the Items Array accessed by At is zero based, from 0 to Count - 1 }
For I := 0 to Pred(SegmentDB.Count) do
Begin
{ Get the Ith PSegmentItem Pointer }
P := SegmentDB.At(I);
{ We only want to list the units that are overlayed;
The initialization of the Collection does a Lookup immediately after
inserting a PSegmentItem in to make sure it was a valid Insert,
which makes LoadCount = 1 before the actual work begins }
With P^ do
Begin
If LoadCount > 1 Then
Begin
Str(LoadCount:0, LCStr);
SwapLogWrite(SegName + ' : ' + LCStr);
End;
End;
End;
If SortUsed <> OvrSegNo Then
Begin
{ Reorder by SegNo so that further overlay logging can be done }
SortUsed := OvrSegNo;
SegmentDB.Reorder;
End;
End;
function NameSegment(Const SegRec : TSegmentItem) : Boolean;
var
P: PSegmentItem;
begin
NameSegment := False;
New(P);
If Assigned(P) Then
Begin
NameSegment := True;
P^ := SegRec;
SegmentDB.Insert(P);
End;
end;
Type
FlushLogFunc = Function(Var TextFile : Text) : Integer;
Var
OpenedLogFile : Boolean;
OverLogName : PathStr;
OverLog : text; { text file, not printer }
OldExitProc : Pointer;
OverLogFlushFunc : FlushLogFunc;
EXEname : NameStr;
EXEDir : DirStr;
Function FlushLog : Integer;
Begin
FlushLog := 0;
{ If no forced flushes are to be done, OverLogFlushFunc = Nil }
If Assigned(OverLogFlushFunc) Then
FlushLog := OverLogFlushFunc(OverLog);
End;
{ This 58 byte function for getting string with current system date, is
only incrementally faster than an equivalent Pascal Function but it
is much smaller }
Function Date : Strg12; assembler;
asm
cld
les di, @Result { get address of output string }
mov ah, 2Ah
int 21h { get system time thru DOS function }
mov ax, cx { get YEAR result in CX }
mov bx, (100 shl 8) + '/' { set BH = 100, BL = '/' }
div bh { divide AX by 100, get quotient and remainder }
mov bh, al { save quotient (century) in BL }
mov al, 0 { set AL to no seperator, remainder already in AH }
push ax
push bx { BX already set }
mov bh, dl { get DAY result in DL }
push bx
mov dl, 10 { put length byte = 10 in DL, MONTH already in DH }
push dx
mov si, 3030h { set up SI for ADDs }
mov bl, 10 { set up BL for DIVs and MODs }
mov cx, 4 { four trips thru loop }
@TopOfLoop:
pop ax { pop something to work on off the stack }
xor dx, dx { setup to make AX = AL, DX = AH }
xchg ah, dl { makes DX = AH = days, months, years, or century }
cmp al, 0 { there will be no seperator between yrs and century }
jz @nosep
stosb { store length byte or seperator }
@nosep :
xchg ax, dx { get days, months, years, or century }
div bl { divide AX by 10, get quotient and remainder }
add ax, si { add 3030h to quotient, remainder into char equivalent }
stosw { store quotient and remainder in output }
loop @TopOfLoop
end;
{ This 49 byte function for getting string with current system time, is
only incrementally faster than an equivalent Pascal Function but it
is much smaller }
Function Time : Strg12; assembler;
asm
cld
mov ah, 2Ch
int 21h { get system time thru DOS function }
les di, @Result { get address of output string }
mov al, '.' { set AL to '.' seperator }
mov ah, dl { get HUNDREDTHS of SECOND result in DL }
push ax
mov dl, ':' { set DL to ':' seperator, SECOND result in DH }
push dx
mov dh, cl { get MINUTE result in CL }
push dx
mov cl, 11 { put fixed length byte of 11 in CL, HOUR is in CH }
push cx
mov si, 3030h { set up SI for ADD }
mov bl, 10 { set up BL to make DIV do a decimal partitioning }
mov cx, 4 { four trips thru loop }
@TopOfLoop:
pop ax { pop something to work on off the stack }
xor dx, dx { setup to make AX = AL, DX = AH }
xchg ah, dl { makes DX = AH = 100ths, secs, mins or hours }
stosb { store length byte or seperator }
xchg ax, dx { get hundredths, seconds, minutes or hours }
div bl { divide AX by 10, get quotient and remainder }
add ax, si { add 3030h to quotient, remainder into char equivalent }
stosw { store quotient and remainder in output }
loop @TopOfLoop
end;
function ByteToHex(BB : byte) : string ; assembler ;
asm
les di, @Result { get address of output string }
mov al, 2
cld
stosb { this string will always be 2 chars long }
mov al, BB { get number }
mov dl, al { save it in DL for later use }
shr al, 1
shr al, 1
shr al, 1
shr al, 1 { divide AL by 16 to get value of high char }
add al, 55 { translate to ord of equivalent char }
cmp al, 64
ja @1 { if AL was 10 to 15, skip additional step }
sub al, 7 { if AL was 0 to 9, must sub 7 to get '0' to '9' }
@1:
stosb { store in first char spot }
mov al, dl { restore AL to original value }
and al, 15 { wipe out high char }
add al, 55 { translate to ord of equivalent char }
cmp al, 64
ja @2 { if AL was 10 to 15, skip additional step }
sub al, 7 { if AL was 0 to 9, must sub 7 to get '0' to '9' }
@2:
stosb { store in second char spot }
end ; { ByteToHex }
Procedure OverExitProc; far;
Begin
ExitProc := OldExitProc;
{ Since after initialization, the Log File can be written to at any overlay
swap, we must keep the file open, and force it to be closed only on exit }
If OpenedLogFile Then
Begin
writeln(OverLog, 'Closed ' + OverLogName);
IO_CloseText(OverLog);
End;
End;
{ Returns the name of the segment at SegRec.SegNo in SegRec.SegName, or false }
Function LookUp(Var SegRec : TSegmentItem) : boolean;
var PSegItem : PSegmentItem;
I : Integer;
begin
Lookup := False;
{ Search in Items Array for Item with SegRec.SegNo, Return I, the index }
if SegmentDB.Search(@SegRec, I) then
Begin
{ Get the Pointer to the Ith item in Items }
PSegItem := SegmentDB.At(I);
{ Increment LoadCount to track how many times this unit is loaded }
Inc(PSegItem^.LoadCount);
{ Return the info in SegRec to be printed }
SegRec := PSegItem^;
Lookup := True;
End
else
begin
{ If the Search was unsuccessful, return the Segment Number as the name }
With SegRec do
Begin
SegName := '?' + ByteToHex(Hi(SegNo)) + ByteToHex(Lo(SegNo));
LoadCount := 0;
End;
end;
end; { LookUp }
Procedure SwapLogWrite(InStr : String);
Begin
{ If the Write was Successful, attempt a Flush from the Overlog Buffer }
If IO_WritelnTextStr(OverLog, InStr) = 0 Then
FlushLog;
End;
Function InitSwap(ALimit, ADelta: Integer) : boolean;
{ reads the program's map into a StringDict }
var
hex_addr : string4; { eg 4C97 }
SegRec : TSegmentItem; { eg 0, OPSTRING, 0 }
InSeg, SegLine,
Stop, NotEmpty : Boolean;
ErrCode : Integer;
mem : longint;
map_file : text; { progname.map }
fname : Dos.PathStr; { filename }
fext : Dos.ExtStr;
map_file_line : string;
begin
InitSwap := False;
{ This procedure will report the heap memory taken by the Collection }
mem := memavail;
{ If the Log File is not open, we have no place to report to so stop }
If Not OpenedLogFile Then
Begin
Writeln('Could not open log file ' + OverLogName + '.');
Writeln('No logging will be done.');
Exit;
End;
{ report when this log was done }
SwapLogWrite('Opened ' + OverLogName + ' on ' + Date + ' at ' + Time);
{ do the actual init of the object which if unsuccessful leaves us no
way of accomplishing our task }
If Not segmentDB.Init(ALimit, ADelta) then
Begin
SwapLogWrite('Unable to init segment mapping object');
Exit;
End;
{ EXEDir and EXEName are set in the LogFile Open; If we can't open the
map, we have no way of associating Segment numbers to unit names }
fname := EXEDir + EXEName + '.MAP';
ErrCode := IO_OpenText(fname, map_file, resetfile);
if ErrCode <> 0 then
Begin
SwapLogWrite('Unable to open map file: ' + fname);
Exit;
End;
SwapLogWrite('Loading: ' + fname);
InSeg := False;
Stop := False;
SegLine := False;
NotEmpty := False;
while (not eof(map_file)) and (ErrCode = 0) and (Not Stop) do
begin
ErrCode := IO_ReadlnTextStr(map_file, map_file_line);
If ErrCode = 0 then
Begin
{ Is the line a Valid Segment Map area line? }
SegLine := (length(map_file_line) >= 40) and (map_file_line[7] = 'H');
{ Is code, or just types and constants, from the unit used? }
NotEmpty := copy(map_file_line,16,5) <> '00000';
{ Until we hit a SegLine, we are not in the SegArea }
If Not InSeg Then
Begin
If SegLine Then
InSeg := True;
End;
If InSeg Then
If SegLine Then
Begin
if NotEmpty Then
begin
{ get the Hex Address String of the Unit }
hex_addr := copy(map_file_line, 2, 4); { eg '4C97' }
With SegRec do
Begin
{ Hex numbers need to be flagged by use of the '$' }
Val('$' + Hex_Addr, SegNo, ErrCode);
{ get the unit name }
SegName := copy(map_file_line, 23, 8); { eg 'OPSTRING' }
{ Setting up a string for latter use }
fname := 'Lookup tested Okay for ' + SegName + ': LC = ';
LoadCount := 0;
SwapLogWrite('Adding ' + hex_addr + ' ' + SegName);
End;
{ put the information in SegRec into the Collection }
If Not NameSegment(SegRec) then
Begin
SwapLogWrite('Failed in Add when adding ' + SegRec.SegName);
IO_CloseText(map_file);
Exit;
End
Else
{ If NameSegment successful, do a lookup to make sure it
was completely successful }
If LookUp(SegRec) then
begin
Str(SegRec.LoadCount:0, EXEname);
SwapLogWrite(fname + EXEName);
End
Else
SwapLogWrite('Lookup did not test Okay for ' + SegRec.SegName);
end;
End
Else
{ allowing blank lines to get in but anything else will stop the read }
If map_file_line <> '' Then
Stop := True;
End;
End;
{ This will show how much heap is being used by the Collection }
Str(mem - memavail:0, EXEname);
SwapLogWrite('Memory used by load= ' + EXEName);
If ErrCode = 0 Then
ErrCode := IO_CloseText(map_file);
If ErrCode = 0 Then
InitSwap := True;
end; { LoadList }
{ The address of this replaces that of the native BP function, so that
the lookup and write to the log can take place before SaveOvrRead calls
the native function to do that actual overlay swap }
Function SwapOverRead( OvrSeg : Word): integer;
var
tempseg : word;
hex_seg : string4;
CountStr : String8;
SegRec : TSegmentItem;
begin
(* In a program, the PrefixSeg variable contains the selector
(segment address) of the Program Segment Prefix (PSP)
created by DOS and Windows when the application was
executed. *)
SegRec.SegNo := OvrSeg - PrefixSeg - $10;
{ If Lookup successful, write the unit SegName and the LoadCount }
if LookUp(SegRec) then
begin
With SegRec do
Begin
Str(LoadCount:0, CountStr);
SwapLogWrite(SegName + ' : ' + CountStr);
end;
End
Else
{ If Lookup unsuccessful, write SegName which now contains the
Address as a HexStr }
SwapLogWrite(SegRec.SegName);
{ Call SaveOvrRead to do the overlay swap }
SwapOverRead := SaveOvrRead(OvrSeg);
end; { MyOverRead }
Procedure SetTypeOfFlush(InFlushType : FlushType);
Begin
{ If InFlushType = NoFlush, OverLogFlushFunc = Nil }
OverLogFlushFunc := Nil;
Case InFlushType Of
FlushToDos : OverLogFlushFunc := IO_FlushToDos;
FlushToDisk : OverLogFlushFunc := IO_FlushToDisk;
End;
End;
Procedure OpenOverLogFile(InName : PathStr);
Var FEXT : EXTStr;
FDir : DirStr;
Begin
{ Parse to get the log file directory and name }
fsplit(InName, FDir, EXEName, FEXT);
{ If no name given, default to OVERLOG.FIL }
If EXEName = '' Then
InName := 'OVERLOG.FIL';
{ Parse to get the executable directory and log name }
fsplit(ParamStr(0), EXEDir, EXEName, FEXT);
{ If no log directory given, default to executable directory }
If FDir = '' Then
FDir := EXEDir;
{ Set the unit variable to allow writing the file name to the file }
OverLogName := FDir + InName;
{ open the file and set the boolean flag accordingly }
OpenedLogFile := IO_OpenText(OverLogName, OverLog, RewriteFile) = 0;
End;
begin
OldExitProc := ExitProc;
ExitProc := @OverExitProc;
GoodInitSwap := False;
OverLogFlushFunc := IO_FlushToDisk;
end.